
(define long-chain
    '((始 读正负号)
      (符号 读数)
      (整数 读点)
      (小数 读e)
      (指数 读正负号)
      (指数符号 读数)
      (指数数 读其他)
      (终 nil)))
(define aux-chain
    '((整数 读数 整数)
      (小数 读数 小数)
      (指数数 读数 指数数)
      (整数 读e 指数)
      (整数 读其他 终)
      (小数 读其他 终)
      (始 读数 整数)
      (指数 读数 指数数)))


(define (lc-length l)
    (length l))
(define (2-3-turple l)
    (let ((nl nil))
      (if (null l) nil
	  (if (listp l)
	      (progn
		(travel l 'for-index i
		      (cond ((null (nth i l)) (return))
			    ((atom (nth i l)) (format t "illegal data([~a]is atom) in long-chain.~%" (nth i l)))
			    ((and (consp (nth i l))(consp (nth (1+ i) l))(= (length (nth i l)) 2)) (push (list (car (nth i l))(cadr (nth i l))(car (nth (1+ i) l))) nl))))
			    ;(t (format t "illegal data([~a]is otherwise) in long-chain.~%" (nth i l)))))
		(reverse nl))
	      (format t "illegal data([~a]is not list) in long-chain.~%" (nth i l))))))
(define (get-all-chain l la)
    (concatenate 'list (2-3-turple l) la))
(define (in-chain st l)
    (let ((inl nil))
      (travel l 'for-child i
	      (if (eql st (nth 2 i)) (push i inl)))
      (reverse inl)))
(define (out-chain st l)
    (let ((outl nil))
      (travel l 'for-child i
	      (if (eql st (car i)) (push i outl)))
      (reverse outl)))
(define (act-in-chain act l)
    (let ((inl nil))
      (travel l 'for-child i
	      (if (eql act (cadr i)) (push i inl)))
      (reverse inl)))
(define (self-chain-num st l)
    (let ((selfl nil))
      (travel l 'for-child i
	      (if (and (eql st (car i))(eql st (nth 2 i))) (push i selfl)))
      (length selfl)))
(define (act-chain l)
    (let ((actl nil))
      (travel l 'for-child i
	      (if (not (member (cadr i) actl :test #'equal)) (push (cadr i) actl)))
      (reverse actl)))
(define (status-chain l)
    (let ((statusl nil))
      (travel l 'for-child i
	      (if (not (member (car i) statusl)) (push (car i) statusl))
	      (if (not (member (nth 2 i) statusl)) (push (nth 2 i) statusl)))
      (reverse statusl)))
(define (res-status l)
   (let ((statusl nil))
      (travel (in-chain '终 l) 'for-child i
	      (if (not (member (car i) statusl)) (push (car i) statusl)))
      (reverse statusl)))
(define (self-chain l)
     (let ((nl nil))
      (travel l 'for-child i
	      (if (eql (car i) (nth 2 i)) (push i nl)))
      (reverse nl)))
(define (single-node-list l)
    (let ((snl nil))
      (travel (status-chain l) 'for-child i
	      (cond ((and (eql i '始)(= (length (in-chain i l)) 0)) nil)
		    ((and (eql i '终)(= (length (out-chain i l)) 0)) nil)
		    ((or  (<= (length (in-chain i l)) (self-chain-num i l))
			  (<= (length (out-chain i l)) (self-chain-num i l)))
		     (push i snl))))
      (reverse snl)))
(define (dup-act-list l)
    (let ((dupl nil))
      (travel l 'for-index i
	      (if (member (nth i l) (nthcdr (1+ i) l) :test #'equal) (if (not (member (nth i l) dupl :test #'equal)) (push (nth i l) dupl))))
      (reverse dupl)))
(define (dup-removal-chain l)
    (let ((ll nil))
      (travel l 'for-child i
	      (if (not (member i ll :test #'equal)) (push i ll)))
      (reverse ll)))
(define (self-removal-chain l)
    (let ((ll nil))
      (travel l 'for-child i
	      (if (eql (car i) (nth 2 i)) nil (push i ll)))
      (reverse ll)))
(define (status-removal-dup l)
    (let ((nl nil))
      (travel l 'for-child i
	      (if (member i nl :test #'equal) nil (push i nl)))
      nl))
(define (out-status-list st l)
    (let ((nl nil))
      (travel (out-chain st l) 'for-child i
	      (push (nth 2 i) nl))
      nl))
(define (in-status-list st l)
    (let ((nl nil))
      (travel (in-chain st l) 'for-child i
	      (push (car i) nl))
      nl))
(define (st-in-list st l)
    (travel l 'for-child i
	    (if (eql st i) (return-from st-in-list t)))
  nil)
(define (through-path l)
    (let ((ll (self-removal-chain l))(nl (list '(始))))
      (push (status-removal-dup (out-status-list '始 ll)) nl)
      (setf nl (make-chain-tree nl ll 1))
      ;(print nl)
      (if (st-in-list '终 (car nl)) nil nl)))
(define (get-make-chain-tree l)
    (let ((ll (self-removal-chain l))(nl (list '(始))))
      (push (out-status-list '始 ll) nl)
      (make-chain-tree nl ll 1)))
      
(define (make-chain-tree nl ll n)
					;(print nl)
    
  (if (< n (* (length ll) 2)) 
    (let ((l nil))
      (travel (car nl) 'for-child i
	      (setf l (concatenate 'list l (out-status-list i ll))))
      (if l (progn (setf l (status-removal-dup l))
		   (if (member l nl :test #'equal) nl
		       (progn (push l nl) (setf n (1+ n))(make-chain-tree nl ll n))))
	  nl))
    nl))
 
    
      
(define (chain-check l)
    (let ((errl nil)(ll nil))
      (if (setf ll (dup-act-list l)) (progn (format t "DUP error(has dupulicate node):~a~%" ll)(push ll errl)))
      (if (setf ll (single-node-list l)) (progn (format t "SIGNAL NODE error(has node not has in or out chain):~a~%" ll)(push ll errl)))
      (if (setf ll (through-path l)) (progn (format t "LONGEST PATH error(can't from 始　to 终):~a~%" ll)(push ll errl)))
      (if errl (format t "!!!please check st file.~%"))
      errl))

(define (read-chain f)
    (setf fn (concatenate 'string (string f) ".st"))
  (let ((lc nil)(la nil)(str nil))
    (setf str (read-into-string fn))
    (multiple-value-bind (lc n) (read-from-string str)
      (setf la (read-from-string (subseq str n (length str))))
      (get-all-chain lc la))))

(define (:macro def-act-func i)
    `(define (:default ,i c) nil nil ,(string i)))
(define (:macro default-act-func l)
    `(travel ,l 'for-child i
	    (def-act-func i)))
    


	  
      
	  
      
      
	      
			     
